unit PsUtils; //Process utilities

interface
uses SysUtils, Windows, Classes;

function CreateProcessAndWait(const Cmd, CurDir: String;
                              Visibility: word): DWord;
function ProcessExecute(CommandLine: string; cShow: Word; CurDir: string = ''): Integer;
function ExecCaptured(CommandLine: string; Output: TStrings; CurDir: string = ''): DWord;
function ExecCapturedNT(CommandLine: string; Output: TStrings; CurDir: string = ''): DWord;
function CreateRedirectedProcess(CmdLine: string; var Output: string; CurDir: string): DWord;
function CreateCapturedOutputProcess(const CommandLine: string; var Buffer;
              BufSize: cardinal; var BytesRead: cardinal; CurDir: string = ''): DWORD;


implementation

function CreateProcessAndWait(const Cmd, CurDir: String;
                              Visibility: word): DWord;
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  Proc: THandle;
  CurD: PChar;
begin
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);
  SI.dwFlags := STARTF_USESHOWWINDOW;
  SI.wShowWindow := Visibility;
  CurD := nil;
  if CurDir <> '' then CurD := PChar(CurDir);
  if not CreateProcess(Nil, PChar(Cmd), Nil, Nil, False,
                   Normal_Priority_Class, Nil, CurD, SI, PI) then
    raise Exception.CreateFmt('Failed to execute program.  Error Code %d',
                                  [GetLastError]);
  Proc := PI.hProcess;
  CloseHandle(PI.hThread);
  if WaitForSingleObject(Proc, Infinite) = WAIT_OBJECT_0 then
    GetExitCodeProcess(Proc, Result);
  CloseHandle(Proc);
end;

function ProcessExecute(CommandLine: string; cShow: Word; CurDir:string): Integer;
var
  Rslt: LongBool;
  StartUpInfo: TStartUpInfo;  // documented as STARTUPINFO
  ProcessInfo: TProcessInformation; // documented as PROCESS_INFORMATION
  ExitCode: cardinal;
  cur_d: PChar;
begin
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo do
  begin
    cb := SizeOf(TStartupInfo); // Specify size of structure
    dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
    wShowWindow := cShow
  end;
  if CurDir = '' then
    cur_d := nil
  else
    cur_d := PChar(CurDir);
  Rslt := CreateProcess(nil, PChar(CommandLine), nil, nil, False,
    NORMAL_PRIORITY_CLASS, nil, cur_d, StartupInfo, ProcessInfo);
  if Rslt then
    with ProcessInfo do
    begin
      //repeat
      //  GetExitCodeProcess(hProcess, ExitCode);
      //until ExitCode <> STILL_ACTIVE;
      WaitForInputIdle(hProcess, INFINITE);
      CloseHandle(hThread); // Free the hThread  handle
      CloseHandle(hProcess);// Free the hProcess handle
      Result := 0;          // Set Result to 0, meaning successful
    end
  else begin
    //Result := GetLastError; // Set result to the error code.
    //RaiseLastWin32Error;
    raise Exception.Create(SysErrorMessage(GetLastError) + #13#10 + CommandLine);
  end;
end;

function ExecCaptured(CommandLine: string; Output: TStrings; CurDir: string = ''): DWord;
var
  Buff: PChar;
  BuffSize, BytesRead: cardinal;
begin
  BuffSize := 4096;
  Buff := AllocMem(BuffSize);
  try
    result := CreateCapturedOutputProcess(CommandLine, Buff^, BuffSize, BytesRead, CurDir);
  finally
    OemToChar(Buff, Buff);
    Output.Add(Buff);
    FreeMem(Buff, BuffSize);
  end;
end;

function ExecCapturedNT(CommandLine: string; Output: TStrings; CurDir: string = ''): DWord;
var s: string;
begin
  result := CreateRedirectedProcess(CommandLine, s, CurDir);
  OemToChar(PChar(s), PChar(s));
  Output.Add(s);
end;

function CreateRedirectedProcess(CmdLine: string; var Output: string; CurDir: string): DWord;
var
  SI: TStartupInfo;
  SA: TSecurityAttributes;
  PI: TProcessInformation;
  hRead, hWrite: THandle;
  Buf: array[0..1024] of char;
  NToRead, NRead: cardinal;
  CurD: PChar;
begin
  Output := '';
  CurD := nil;
  if CurDir <> '' then CurD := PChar(CurDir);
  //
  FillChar(SA, SizeOf(SA), 0);
  SA.nLength := SizeOf(SA);
  SA.lpSecurityDescriptor := nil;
  SA.bInheritHandle := True;
  Win32Check(CreatePipe(hRead, hWrite, @SA, 0));
  //
  FillChar(SI, SizeOf(SI), 0);
  FillChar(PI, SizeOf(PI), 0);
  with SI do begin
    cb := SizeOf(TStartUpInfo);
    dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    wShowWindow := SW_HIDE;
    hStdInput := hRead;
    hStdOutput := hWrite;
  end;
  //AllocConsole;
  Win32Check(CreateProcess(nil, PChar(CmdLine), nil, nil, True, 0, nil, CurD, SI, PI));
  //FreeConsole;
  WaitForSingleObject(PI.hProcess, INFINITE);
  GetExitCodeProcess(PI.hProcess, Result);     // Get exit code for process
  CloseHandle(PI.hThread);
  CloseHandle(PI.hProcess);
  //
  CloseHandle(hWrite);
  NRead := 0;
  FillChar(Buf, SizeOf(Buf), 0);
  Win32Check(ReadFile(hRead, Buf, SizeOf(Buf), NRead, nil));
  CloseHandle(hRead);
  //
  Output := Copy(Buf, 1, NRead);
end;

function CreateCapturedOutputProcess(const CommandLine: string; var Buffer;
  BufSize: cardinal; var BytesRead: cardinal; CurDir: string): DWORD;
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  OutHand, PipeRead, PipeWrite, PipeReadDup: THandle;
  BuffPtr: PByte;
  SA: TSecurityAttributes;
  CurD: PChar;
  res: BOOL;
begin
  CurD := nil;
  if CurDir <> '' then CurD := PChar(CurDir);
  //
  OutHand := GetStdHandle(STD_OUTPUT_HANDLE);  // Save current output handle
  try
    with SA do
    begin
      nLength := SizeOf(SA);
      lpSecurityDescriptor := Nil;
      bInheritHandle := True;                  // make handles inheritable
    end;
    // Create anonymous pipe, and use it as the output handle
    Win32Check(CreatePipe(PipeRead, PipeWrite, @SA, 0));
    Win32Check(SetStdHandle(STD_OUTPUT_HANDLE, PipeWrite));
    FillChar(SI, SizeOf(SI), 0);
    with SI do
    begin
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW;
      wShowWindow := SW_HIDE;                  // don't show window
    end;
    //
    //res := DuplicateHandle(GetCurrentProcess(), PipeRead, GetCurrentProcess(),
    //  @PipeReadDup , 0, FALSE, DUPLICATE_SAME_ACCESS);
    //CloseHandle(PipeRead);
    //
      // Create the process, child process inherits our handles
    res := CreateProcess(Nil, PChar(CommandLine), Nil, Nil, True, 0, Nil,
        CurD, SI, PI);
    if not res then begin
      // if an error occurs while creating the process, make sure pipe
      // handles are closed.
      CloseHandle(PipeRead);
      CloseHandle(PipeWrite);
      raise Exception.Create(SysErrorMessage(GetLastError) + #13#10 + CommandLine);
    end;
    CloseHandle(PI.hThread);   // close child process' thread handle
    CloseHandle(PipeWrite);    // close pipe write handle
    BuffPtr := @Buffer;
    BytesRead := 0;
    // keep reading from pipe until we run out of buffer or until ReadFile
    // returns False.  It will return False when child process closes it's
    // write handle for pipe.
    res := True;
    while (BytesRead < BufSize) and res do
    begin
      inc(BuffPtr, BytesRead);
      res := ReadFile(PipeRead, BuffPtr^, BufSize - BytesRead, BytesRead, Nil);
      //if not res then RaiseLastWin32Error;
    end;
    CloseHandle(PipeRead);                       // done with read handle
    WaitForSingleObject(PI.hProcess, INFINITE);  // make sure process terminates
    GetExitCodeProcess(PI.hProcess, Result);     // Get exit code for process
    CloseHandle(PI.hProcess);                    // close child process handle
  finally
    SetStdHandle(STD_OUTPUT_HANDLE, OutHand);    // restore original output handle
  end;
end;

end.
